
;;; Copyright (c) 2008, Eric Rochester
;;; All rights reserved.
;;; 
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions are met:
;;; 
;;;    * Redistributions of source code must retain the above copyright notice,
;;;      this list of conditions and the following disclaimer.
;;;    * Redistributions in binary form must reproduce the above copyright
;;;      notice, this list of conditions and the following disclaimer in the
;;;      documentation and/or other materials provided with the distribution.
;;;    * Neither the name of the word-clj nor the names of its contributors 
;;;      may be used to endorse or promote products derived from this 
;;;      software without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
;;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
;;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 
;;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 
;;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 
;;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(in-ns 'concord)
(clojure/refer 'clojure)

(def test-text "
  OK, that's enough of a break.

  Now we've got some processing tools under our belts: tokenizing and stemming.
  We'll probably add more later, and we'll definitely tweak those. But now let's
  take a look at our data.

  One of the earliest ways of analyzing texts is the [concordance][]. The first
  was done in the thirteenth century for the Vulgate translation of the
  Christian Bible. However, because complete concordances are labor-intensive,
  they really weren't practical as a wide-spread tool. Because of this,
  concordances were only made for important works, such as religious texts or
  the works of Shakespeare or Chaucer.
  ")

(def tokens (vec (word/tokenize-str test-text)))

(defn get-types [tokens]
  "This returns the set of types in the text."
  (set (map :text tokens)))

(defn index-tokens
  "This indexes all the tokens into a map by types."
  ([tokens]
   (index-tokens (seq tokens) {}))
  ([tokens idx]
   (if-let token (first (seq tokens))
     (let [text (:text token), seen (idx text)]
       (recur (rest tokens)
              (if seen
                (assoc idx text (conj seen token))
                (assoc idx text (vector token)))))
     idx)))

(defn star-highlighter
  [word]
  (str \* word \*))

(defn concord-word
  "This creates a concordance for a given word. It returns the lines of the
  concordance."
  [tokens lines context]
  (when-first token (seq tokens)
    (lazy-cons
      (let [line-no (:line token),
            line (nth lines line-no),
            start (:start token),
            end (:end token)]
        (vector (vector line-no start end)
                (.substring line (max (- start context) 0) start)
                (.substring line start end)
                (.substring line end (min (+ end context) (.length line)))))
      (concord-word (rest tokens) lines context))))

(defn concordance
  "This creates and prints a complete concordance."
  [index lines context]
  (let [lines (vec lines), fmt (str "%3d:%3d:%3d %" context "s*%s*%s")]
    (doseq word (sort (keys index))
      (println word)
      (println (apply str (take (.length word) (repeat \=))))
      (doseq [[line-no start end] pre hit post] (concord-word (index word) lines context)
        (printf fmt line-no start end pre hit post)
        (println))
      (println))))

(comment
  ;; Here's how to use this.

  (def tokens (word/tokenize-str test-text))
  (def index (index-tokens tokens))
  (def lines (word/split-lines test-text))
  (def word-concord (concord-word (index "word") tokens lines 20))

  (with-open out (java.io.BufferedWriter. (java.io.FileWriter. "concord.txt"))
    (binding [*out* out]
      (concordance index lines 20)))

  )

